home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon_Sources / OOP_in_Oberon-2 / AsciiTexts.mod next >
Text File  |  1993-01-13  |  3KB  |  83 lines
  1. MODULE AsciiTexts; (*HM Mar-25-92*)
  2. IMPORT OS, Viewers0;
  3. CONST minBufLen = 32;
  4. TYPE
  5.         Buffer = POINTER TO ARRAY OF CHAR;
  6.         Text* = POINTER TO TextDesc;
  7.         TextDesc* = RECORD (OS.ObjectDesc)
  8.                 len-: LONGINT;
  9.                 pos-: LONGINT;  (*read/write position*)
  10.                 buf: Buffer;
  11.                 gap: LONGINT (*index of first byte in gap*)
  12.         END;
  13.         NotifyInsMsg* = RECORD (OS.Message) t*: Text; beg*, end*: LONGINT END;
  14.         NotifyDelMsg* = RECORD (OS.Message) t*: Text; beg*, end*: LONGINT END;
  15. PROCEDURE (t: Text) MoveGap (to: LONGINT);
  16.         VAR n, gapLen: LONGINT;
  17. BEGIN n := ABS(to - t.gap); gapLen := LEN(t.buf^) - t.len;
  18.         IF to > t.gap THEN OS.Move(t.buf^, t.gap + gapLen, t.buf^, t.gap, n)
  19.         ELSIF to < t.gap THEN OS.Move(t.buf^, t.gap - n, t.buf^, t.gap + gapLen - n, n)
  20.         END;
  21.         t.gap := to
  22. END MoveGap;
  23. PROCEDURE (t: Text) Grow (size: LONGINT);
  24.         VAR bufLen: LONGINT; old: Buffer;
  25. BEGIN bufLen := LEN(t.buf^);
  26.         IF size > bufLen THEN t.MoveGap(t.len);
  27.                 WHILE bufLen < size DO bufLen := 2*bufLen END;
  28.                 old := t.buf; NEW(t.buf, bufLen); OS.Move(old^, 0, t.buf^, 0, t.len)
  29.         END
  30. END Grow;
  31. PROCEDURE (t: Text) Shrink;
  32.         VAR bufLen: LONGINT; old: Buffer;
  33. BEGIN bufLen := LEN(t.buf^); t.MoveGap(t.len);
  34.         WHILE (bufLen >= 2*t.len) & (bufLen > minBufLen) DO bufLen := bufLen DIV 2 END;
  35.         old := t.buf; NEW(t.buf, bufLen); OS.Move(old^, 0, t.buf^, 0, t.len)
  36. END Shrink;
  37. PROCEDURE (t: Text) Clear*;
  38. BEGIN NEW(t.buf, minBufLen); t.gap := 0; t.pos := 0; t.len := 0
  39. END Clear;
  40. PROCEDURE (t: Text) Insert* (at: LONGINT; t1: Text; beg, end: LONGINT);
  41.         VAR len: LONGINT; m: NotifyInsMsg; t0: Text;
  42. BEGIN
  43.         IF t = t1 THEN NEW(t0); t0.Clear; t0.Insert(0, t1, beg, end); t.Insert(at, t0, 0, t0.len)
  44.         ELSE len := end - beg;
  45.                 IF t.len + len > LEN(t.buf^) THEN t.Grow(t.len + len) END;
  46.                 t.MoveGap(at); t1.MoveGap(end);
  47.                 OS.Move(t1.buf^, beg, t.buf^, t.gap, len);
  48.                 INC(t.gap, len); INC(t.len, len);
  49.                 m.t := t; m.beg := at; m.end := at + len; Viewers0.Broadcast(m)
  50.         END
  51. END Insert;
  52. PROCEDURE (t: Text) Delete* (beg, end: LONGINT);
  53.         VAR m: NotifyDelMsg;
  54. BEGIN t.MoveGap(end); t.gap := beg; DEC(t.len, end-beg);
  55.         IF (t.len * 2 < LEN(t.buf^)) & (LEN(t.buf^) > minBufLen) THEN t.Shrink END;
  56.         m.t := t; m.beg := beg; m.end := end; Viewers0.Broadcast(m)
  57. END Delete;
  58. PROCEDURE (t: Text) SetPos* (pos: LONGINT);
  59. BEGIN t.pos := pos END SetPos;
  60. PROCEDURE (t: Text) Read* (VAR ch: CHAR);
  61.         VAR i: LONGINT;
  62. BEGIN i := t.pos;
  63.         IF t.pos >= t.gap THEN INC(i, LEN(t.buf^) - t.len) END;
  64.         IF t.pos < t.len THEN ch := t.buf[i]; INC(t.pos) ELSE ch := 0X END
  65. END Read;
  66. PROCEDURE (t: Text) Write* (ch: CHAR);
  67.         VAR m: NotifyInsMsg;
  68. BEGIN
  69.         IF t.len = LEN(t.buf^) THEN t.Grow(t.len + 1) END;
  70.         IF t.pos # t.gap THEN t.MoveGap(t.pos) END;
  71.         t.buf[t.gap] := ch; INC(t.gap); INC(t.pos); INC(t.len); 
  72.         m.t := t; m.beg := t.gap-1; m.end := t.gap; Viewers0.Broadcast(m)
  73. END Write;
  74. PROCEDURE (t: Text) Load* (VAR r: OS.Rider);
  75.         VAR len: LONGINT;
  76. BEGIN t.Clear; r.ReadLInt(len); t.Grow(len); r.ReadChars(t.buf^, len);
  77.         t.gap := len; t.len := len
  78. END Load;
  79. PROCEDURE (t: Text) Store* (VAR r: OS.Rider);
  80. BEGIN t.MoveGap(t.len); r.WriteLInt(t.len); r.WriteChars(t.buf^, t.len)
  81. END Store;
  82. END AsciiTexts.
  83.